home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / CHEKSURF.INC < prev    next >
Text File  |  1991-09-25  |  2KB  |  70 lines
  1. function CHEKSURF (X, Y: integer; Surf: word): boolean;
  2. { Check to see if point (X,Y) lies within surface Surf. Function returns
  3.   TRUE if surface blocks point, or false otherwise
  4. }
  5. var Npts: integer;        { # points on outline of surface }
  6.     Xpt, Ypt: points;     { coordinates of surface outline }
  7.     Nextpt: integer;      { next point on outline to look at }
  8.     Node1, Node2: word;   { endpoints of line segment to store }
  9.     Vert: integer;        { vertex number }
  10.  
  11. begin
  12. {$ifdef BIGMEM}
  13. with ptrd^ do with ptre^ do with ptrh^ do
  14. begin
  15. {$endif}
  16.   if (inlimits (X, Y, Surf)) then begin
  17.     Npts := 0;
  18.     for Vert := 1 to Nvert[Surf]-1 do begin
  19.       Node1 := konnec (Surf, Vert);
  20.       Node2 := konnec (Surf, Vert+1);
  21.       storline (round(Xtran[Node1]), round(Ytran[Node1]),
  22.                 round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
  23.       if (Npts < 0) then
  24.         badsurf;
  25.     end; { for Vert }
  26. { One last line to close the polygon }
  27.     Node1 := konnec (Surf, Nvert[Surf]);                { last node }
  28.     Node2 := konnec (Surf, 1);                          { first node }
  29.     storline (round(Xtran[Node1]), round(Ytran[Node1]),
  30.               round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
  31.     if (Npts < 0) then
  32.       badsurf;
  33.  
  34. { Sort the line segment points, first by Y, then by X }
  35.     Shellpts (Xpt, Ypt, Npts);
  36.  
  37. { Now check every point in the interior of the surface to find (X,Y) }
  38.     Nextpt := 1;
  39.     while (Nextpt < Npts) and (Nextpt > 0) do begin
  40.       if (Ypt[Nextpt] = Y) then begin
  41.         if (abs(Xpt[Nextpt] - Xpt[Nextpt+1]) > 1) and
  42.             (Ypt[Nextpt] = Ypt[Nextpt+1]) then begin
  43.           if (Xpt[Nextpt] <= X) and (Xpt[Nextpt+1] >= X) then
  44.             { Point found; flag to stop the while loop }
  45.             Nextpt := -1
  46.           else
  47.             Nextpt := Nextpt + 2;
  48.         end else if (Xpt[Nextpt] = X) then
  49.           { Point found; flag to stop the while loop }
  50.           Nextpt := -1
  51.         else
  52.           Nextpt := Nextpt + 1;
  53.       end else { if Ypt }
  54.         Nextpt := Nextpt + 1;
  55.     end; { while }
  56.     if (Nextpt = Npts) then
  57.       if (Xpt[Nextpt] = X) then
  58.         { Point found; flag to stop the while loop }
  59.         Nextpt := -1;
  60.     if (Nextpt = -1) then
  61.       Cheksurf := TRUE
  62.     else
  63.       Cheksurf := FALSE;
  64.   end else { if onscreen }
  65.     Cheksurf := FALSE;
  66. {$ifdef BIGMEM}
  67. end; {with}
  68. {$endif}
  69. end; { function CHEKSURF }
  70.